Market Measures - July 10, 2018

The setup - Montly SPY 16 delta strangles, 45DTE, hold to expiration, 1-5x loss of credit recieved

Stop losses are a popular strategy used by traders to achieve better performance by closing out of a losing trade.

tastytrade ran a study where they compared managing 16 delta strangles in SPY, 45 DTE at expiration and 1x-5x credit received losses. They found that on average, stop losses hurt performance over the long run, because most of the trades you stopped out of eventually had a better P/L at expiration.

Here I will recreate this study and extend it to include more underlyings to practice using the purrr package. This is the first attempt at recreating a Market Measure study and will be the basis of the tastytrade package on github.

Setup global options, load libraries:

knitr::opts_chunk$set(message = FALSE, tidy.opts = list(width.cutoff = 60)) 
suppressWarnings(suppressMessages(suppressPackageStartupMessages({
  library_list <- c("tastytrade", "dplyr", "ggplot2", "plotly", "gridExtra")
  lapply(library_list, require, character.only = TRUE)})))

stock_list <- c("SPY", "IWM", "GLD", "QQQ", "DIA", "TLT", "XLE", "EEM",
                "MA", "FB", "FXI", "SLV", "EWZ", "FXE", "TBT", "IBM")
tar_dte <- 45
tar_delta_put <- -.16
tar_delta_call <- .16
all_loss_table <- data.frame()
all_results <- data.frame()

Study function

study <- function(stock) {
  options <- readRDS(paste0(here::here(), "/data/options/", stock, ".RDS")) %>%
    dplyr::mutate(mid = (bid + ask) / 2)
  monthly <- readRDS(paste0(here::here(), "/data/monthly.RDS"))
  
  options_filtered <- options %>%
    dplyr::filter(quotedate %in% monthly$date) %>%
    dplyr::mutate(m_dte = abs(dte - tar_dte))
  
  short_put_opens <- tastytrade::open_short_put(options_filtered, stock, 
                                                tar_delta_put)
  short_call_opens <- tastytrade::open_short_call(options_filtered, stock,
                                                  tar_delta_call)
  
  all_trades <- dplyr::full_join(short_call_opens, short_put_opens, 
                                 by = c("quotedate", "expiration", "dte")) %>%
    dplyr::mutate(credit = mid_put + mid_call)
  
  all_closes <- data.frame()
  
  possible_closes <- function(date, exp, c_strike, p_strike, credit) {
    closes <- options %>%
      dplyr::filter(quotedate > date,
                    quotedate <= exp,
                    expiration == exp) %>%
      dplyr::filter((strike == c_strike & type == "call") |
                      (strike == p_strike & type == "put")) %>%
      dplyr::group_by(quotedate) %>%
      dplyr::mutate(open_date = as.Date(date, origin = "1970-01-01"),
                    open_credit = credit,
                    debit = sum(mid),
                    profit = open_credit - debit,
                    loss_1_x = ifelse(debit >= 2 * credit, 1, 0),
                    loss_2_x = ifelse(debit >= 3 * credit, 1, 0),
                    loss_3_x = ifelse(debit >= 4 * credit, 1, 0),
                    loss_4_x = ifelse(debit >= 5 * credit, 1, 0),
                    loss_5_x = ifelse(debit >= 6 * credit, 1, 0)) %>%
      dplyr::ungroup() %>%
      dplyr::select(symbol, quotedate, expiration, open_date, open_credit,
                    debit, profit, loss_1_x, loss_2_x, loss_3_x, loss_4_x,
                    loss_5_x) %>%
      dplyr::distinct()
    
    all_closes <<- rbind(all_closes, closes)
  }
  
  invisible(purrr::pmap(list(all_trades$quotedate, all_trades$expiration,
                             all_trades$strike_call, all_trades$strike_put, 
                             all_trades$credit), possible_closes))
  
  invisible(purrr::pmap(list(df = list(all_closes), 
                             col_name = list("loss_1_x", "loss_2_x", "loss_3_x",
                                             "loss_4_x", "loss_5_x")),
                        tastytrade::stop_loss))
  
  expiration <- all_closes %>%
    dplyr::group_by(open_date) %>%
    dplyr::filter(quotedate == expiration) %>%
    dplyr::ungroup() %>%
    dplyr::arrange(quotedate) %>%
    dplyr::mutate(portfolio = cumsum(profit) * 100,
                  loss_type = "expiration")
  
  symbol_results <- dplyr::bind_rows(loss_1_x, loss_2_x) %>%
    dplyr::bind_rows(loss_3_x) %>%
    dplyr::bind_rows(loss_4_x) %>%
    dplyr::bind_rows(loss_5_x) %>%
    dplyr::bind_rows(expiration)
  
  all_results <- rbind(all_results, symbol_results)
  assign("all_results", all_results, envir = .GlobalEnv)
  
  this_loss_table <- dplyr::bind_rows(loss_1_x, loss_2_x) %>%
    dplyr::bind_rows(loss_3_x) %>%
    dplyr::bind_rows(loss_4_x) %>%
    dplyr::bind_rows(loss_5_x) %>%
    dplyr::bind_rows(expiration) %>%
    dplyr::group_by(loss_type) %>%
    dplyr::filter(open_date == max(open_date)) %>%
    dplyr::ungroup() %>%
    dplyr::mutate(rank = rank(-portfolio)) %>%
    dplyr::select(symbol, loss_type, rank) %>%
    tidyr::spread(., key = loss_type, value = rank)
  
  all_loss_table <- rbind(all_loss_table, this_loss_table) 
  assign("all_loss_table", all_loss_table, envir = .GlobalEnv)
}

Run the study with purrr::map on each symbol

invisible(purrr::map(stock_list, study))

Group returns to similar portfolio outcomes and split so the plots are not as large

group_one_returns <- all_results %>%
  dplyr::filter(symbol %in% c("EWZ", "TLT", "SLV", "FXI", "XLE", "EEM", "FXE"))
group_two_returns <- all_results %>%
  dplyr::filter(symbol %in% c("GLD", "QQQ", "DIA", "IWM", "IBM", "SPY", "MA"))

grouped_plot <- function(df) {
  ggplot(data = df, aes(x = quotedate, y = portfolio)) +
    geom_line(data = dplyr::filter(df, loss_type == "loss_1_x"), 
              aes(group = loss_type, color = "1X Stop")) +
    geom_line(data = dplyr::filter(df, loss_type == "loss_2_x"),
              aes(color = "2X Stop")) +
    geom_line(data = dplyr::filter(df, loss_type == "loss_3_x"),
              aes(color = "3X Stop")) +
    geom_line(data = dplyr::filter(df, loss_type == "loss_4_x"),
              aes(color = "4X Stop")) +
    geom_line(data = dplyr::filter(df, loss_type == "loss_5_x"),
              aes(color = "5X Stop")) +
    geom_line(data = dplyr::filter(df, loss_type == "expiration"),
              aes(color = "expiration")) +
    scale_fill_brewer() +
    theme_dark() + 
    labs(title = "Portfolio Total Return (by stop loss)", x = "Trade Open Date",
         y = "Portfolio Value") +
    facet_grid(rows = vars(symbol), scales = "free_y")
}

grouped_plot(group_one_returns)

grouped_plot(group_two_returns)

This heat map shows the outcomes by stop loss type the darker the color the better the outcome

These are ranked from (1-6) 1 being best
On average holding to expiration performed best and stopping out too early performed the worst as seen in the mean total row at the top.

heat_map_data <- all_loss_table %>%
  dplyr::bind_rows(summarise_all(., funs(if (is.numeric(.)) mean(.) else "Mean Total"))) %>%
  tibble::remove_rownames(.) %>%
  tibble::column_to_rownames(var = "symbol")
heat_map_data <- as.matrix(heat_map_data)

plot_ly(x = colnames(heat_map_data), y = rownames(heat_map_data), 
        z = heat_map_data, type = "heatmap", 
        colors = colorRamp(c("red", "yellow")))